An Introduction to Progr…l Basic 6.0 (4th Edition)/An Introduction to Programming using Visual Basic 6.0.iso/PROGRAMS/CH7/7-6.FRM

Visual Basic Form | 1998-09-19 | 10.9 KB | 327 lines

VERSION 5.00
Begin VB.Form frmSpreadsheet
   Caption         =   "Spreadsheet"
   ClientHeight    =   1344
   ClientLeft      =   168
   ClientTop       =   1896
   ClientWidth     =   8052
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   7.8
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1344
   ScaleWidth      =   8052
   Begin VB.TextBox txtCell
      Height          =   314
      Index           =   1
      Left            =   396
      TabIndex        =   4
      Top             =   792
      Width           =   1205
   End
   Begin VB.CommandButton cmdQuit
      Caption         =   "Quit"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   281
      Left            =   4224
      TabIndex        =   3
      Top             =   132
      Width           =   1469
   End
   Begin VB.CommandButton cmdNew
      Caption         =   "New"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   281
      Left            =   2376
      TabIndex        =   2
      Top             =   132
      Width           =   1469
   End
   Begin VB.Label lblColLab
      Caption         =   "A"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   281
      Index           =   1
      Left            =   924
      TabIndex        =   1
      Top             =   528
      Width           =   281
   End
   Begin VB.Label lblRowLab
      Caption         =   "1"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   281
      Index           =   1
      Left            =   0
      TabIndex        =   0
      Top             =   792
      Width           =   281
   End
Attribute VB_Name = "frmSpreadsheet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim maxCol As Integer         'Number of columns in spreadsheet
Dim maxRow As Integer         'Number of rows in spreadsheet
Dim incStartRow As Integer    'Row where income categories begin
Dim incStopRow As Integer     'Row where income categories end
Dim incTotRow As Integer      'Row where income total is displayed
Dim expStartRow As Integer    'Row where expense categories begin
Dim expStopRow As Integer     'Row where expense categories end
Dim expTotRow As Integer      'Row where expense total is displayed
Dim balRow As Integer         'Row where balance is displayed
Dim startCol As Integer       'Column where numeric data begins
Dim stopCol As Integer        'Column where numeric data ends
Dim totCol As Integer         'Column where total for each row is displayed
'Control Arrays
'txtCell()                     Control array for data cells
'lblRowLab()                   Control array for numeric row labels
'lblColLab()                   Control array for alphabetic column labels
Private Sub cmdNew_Click()
  Dim row As Integer, col As Integer
  'Clear all data and total text boxes
  For col = 1 To maxCol
    For row = 1 To maxRow
      txtCell(Indx(row, col)).Text = ""
    Next row
  Next col
  Call SetStructure
  'Place cursor in first data txtCell
  txtCell(Indx(1, 1)).SetFocus
End Sub
Private Sub cmdQuit_Click()
  End
End Sub
Private Sub CreateSpreadsheet()
  Dim row As Integer, col As Integer, i As Integer
  Dim cellHeight As Single, cellWidth As Single
  Dim cellTop As Single, cellLeft As Single
  cellHeight = txtCell(1).Height
  cellWidth = txtCell(1).Width
  'Create cells
  For row = 1 To maxRow
    For col = 1 To maxCol
      i = Indx(row, col)
      If Not (col = 1 And row = 1) Then
          Load txtCell(i)
      End If
      If row > 1 Then
          cellTop = txtCell(Indx(row - 1, col)).Top
          txtCell(i).Top = cellTop + cellHeight
      End If
      If col > 1 Then
          cellLeft = txtCell(Indx(row, col - 1)).Left
          txtCell(i).Left = cellLeft + cellWidth
      End If
      txtCell(i).Visible = True
    Next col
  Next row
  'Create Row Labels
  For row = 2 To maxRow
    Load lblRowLab(row)
    lblRowLab(row).Top = lblRowLab(row - 1).Top + cellHeight
    lblRowLab(row).Caption = LTrim(Str(row))
    lblRowLab(row).Visible = True
  Next row
  'Create Column Labels
  For col = 2 To maxCol
    Load lblColLab(col)
    lblColLab(col).Left = lblColLab(col - 1).Left + cellWidth
    lblColLab(col).Caption = Chr(col + 64)
    lblColLab(col).Visible = True
  Next col
  'Set form height and width to accommodate all objects
  i = Indx(maxRow, maxCol)
  frmSpreadsheet.Height = txtCell(i).Top + cellHeight + 500
  frmSpreadsheet.Width = txtCell(i).Left + cellWidth + 200
End Sub
Private Sub DisplayTotals()
  ReDim itot(startCol To stopCol) As Single
  ReDim etot(startCol To stopCol) As Single
  'Calculate and show totals for Income each quarter
  Call TotalIncome(itot())
  'Calculate and show totals for Expenses each quarter
  Call TotalExpenses(etot())
  'Calculate and show Balances for each quarter
  Call ShowBalances(itot(), etot())
  'Calculate and show the Total of each Income & Expense category
  Call TotalRows
  'Calculate and show grand totals of quarter totals and balances
  Call ShowGrandTotals(itot(), etot())
End Sub
Private Sub Form_Load()
  'Establish number of rows and columns. Trial and error show
  'that a maximum of 20 rows and 8 columns will fit the screen.
  'For this particular application, 16 rows and 6 columns are adequate.
  maxRow = 16
  maxCol = 6
  Call CreateSpreadsheet
  Call SetStructure
  Call SetDefaults
End Sub
Private Function Indx(row As Integer, col As Integer) As Integer
  Indx = (row - 1) * maxCol + col
End Function
Private Sub SetDefaults()
  'Set default values specific to this application
  txtCell(Indx(3, 1)).Text = "Job"
  txtCell(Indx(4, 1)).Text = "Parents"
  txtCell(Indx(5, 1)).Text = "Scholarship"
  txtCell(Indx(9, 1)).Text = "Tuition"
  txtCell(Indx(10, 1)).Text = "Food"
  txtCell(Indx(11, 1)).Text = "Rent"
  txtCell(Indx(12, 1)).Text = "Books"
  txtCell(Indx(13, 1)).Text = "Misc"
End Sub
Private Sub SetStructure()
  txtCell(Indx(1, 2)).Text = "Fall"
  txtCell(Indx(1, 3)).Text = "Winter"
  txtCell(Indx(1, 4)).Text = "Spring"
  txtCell(Indx(1, 5)).Text = "Summer"
  txtCell(Indx(1, 6)).Text = "Total"
  txtCell(Indx(1, 6)).ForeColor = vbGreen
  txtCell(Indx(2, 1)).Text = "Income"
  txtCell(Indx(2, 1)).ForeColor = vbMagenta
  txtCell(Indx(6, 1)).Text = "Total"
  txtCell(Indx(6, 1)).ForeColor = vbGreen
  txtCell(Indx(8, 1)).Text = "Expenses"
  txtCell(Indx(8, 1)).ForeColor = vbMagenta
  txtCell(Indx(14, 1)).Text = "Total"
  txtCell(Indx(14, 1)).ForeColor = vbGreen
  txtCell(Indx(16, 1)).Text = "Balance"
  txtCell(Indx(16, 1)).ForeColor = vbGreen
  incStartRow = 3
  incStopRow = 5
  incTotRow = 6
  expStartRow = 9
  expStopRow = 13
  expTotRow = 14
  balRow = 16
  startCol = 2
  stopCol = 5
  totCol = 6
End Sub
Private Sub ShowBalances(itot() As Single, etot() As Single)
  Dim col As Integer
  For col = startCol To stopCol
    txtCell(Indx(balRow, col)).Text = FormatNumber(itot(col) - etot(col), 0)
  Next col
End Sub
Private Sub ShowGrandTotals(itot() As Single, etot() As Single)
  Dim col As Integer, iTotal As Single, eTotal As Single
  'Compute and display grand totals for income, expenses, and balance
  iTotal = 0
  eTotal = 0
  For col = startCol To stopCol
    iTotal = iTotal + itot(col)
    eTotal = eTotal + etot(col)
  Next col
  txtCell(Indx(incTotRow, totCol)) = FormatNumber(iTotal, 0)
  txtCell(Indx(expTotRow, totCol)) = FormatNumber(eTotal, 0)
  txtCell(Indx(balRow, totCol)) = FormatNumber(iTotal - eTotal, 0)
End Sub
Private Sub TotalExpenses(etot() As Single)
  Dim row As Integer, col As Integer
  'Total expenses for each of four quarters
  For col = startCol To stopCol
    etot(col) = 0
    For row = expStartRow To expStopRow
      etot(col) = etot(col) + Val(txtCell(Indx(row, col)).Text)
    Next row
    txtCell(Indx(expTotRow, col)).Text = FormatNumber(etot(col), 0)
  Next col
End Sub
Private Sub TotalIncome(itot() As Single)
  Dim row As Integer, col As Integer
  'Total income for each of four quarters
  For col = startCol To stopCol
    itot(col) = 0
    For row = incStartRow To incStopRow
      itot(col) = itot(col) + Val(txtCell(Indx(row, col)).Text)
    Next row
    txtCell(Indx(incTotRow, col)).Text = FormatNumber(itot(col), 0)
  Next col
End Sub
Private Sub TotalRows()
  Dim row As Integer, col As Integer, rowTot As Single
  'Total each income category
  For row = incStartRow To incStopRow
    rowTot = 0
    For col = startCol To stopCol
      rowTot = rowTot + Val(txtCell(Indx(row, col)).Text)
    Next col
    txtCell(Indx(row, totCol)).Text = FormatNumber(rowTot, 0)
  Next row
  'Total each expense category
  For row = expStartRow To expStopRow
    rowTot = 0
    For col = startCol To stopCol
      rowTot = rowTot + Val(txtCell(Indx(row, col)).Text)
    Next col
    txtCell(Indx(row, totCol)).Text = FormatNumber(rowTot, 0)
  Next row
End Sub
Private Sub txtCell_GotFocus(Index As Integer)
  Dim row As Integer, col As Integer
  'Force focus into a data txtCell for this application
  row = Int((Index - 1) / maxCol) + 1
  col = ((Index - 1) Mod maxCol) + 1
  If col > stopCol Then
      row = row + 1
      col = startCol
  End If
  If row < incStartRow Then
      row = incStartRow
    ElseIf (row > incStopRow) And (row < expStartRow) Then
      row = expStartRow
    ElseIf row > expStopRow Then
      row = incStartRow
  End If
  If Indx(row, col) <> Index Then
      txtCell(Indx(row, col)).SetFocus
  End If
End Sub
Private Sub txtCell_LostFocus(Indx As Integer)
  Call DisplayTotals
End Sub